home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dskut / xlat11.zip / CONFXLAT.PAS < prev    next >
Pascal/Delphi Source File  |  1990-08-12  |  37KB  |  1,112 lines
  1. Program confxlat;
  2. { Customize a XLAT(R).COM programme                                          }
  3. { FreeWare by TapirSoft Gisbert W.Selke, Oct 1989/Aug 1990                   }
  4.  
  5. {$UNDEF  DEBUG }        { DEFINE while debugging }
  6.  
  7. {$A+,B-,D+,E+,F-,I+,L+,N-,O-,V- }
  8. {$M 16384,0,16384 }
  9. {$IFDEF DEBUG }
  10.   {$R+,S+ }
  11. {$ELSE }
  12.   {$R-,S- }
  13. {$ENDIF }
  14.  
  15.   Uses Dos, Crt;
  16.  
  17.   Const progname  = 'ConfXlat';
  18.         version   = '1.1';
  19.         copyright = 'FreeWare by TapirSoft Gisbert W.Selke, Oct 1989/Aug 1990';
  20.         idstring10= 'XLAT10';
  21.         idstring11= 'XLAT11';
  22.         idlength  = Length(idstring10);
  23.         hexnibble : string[16] = '0123456789ABCDEF';
  24.         digits    : string[10] = '0123456789';
  25.  
  26.   Const fbufsize = 4096;
  27.         width    = 18;
  28.         videoint = $10;
  29.         blockcur = $010C;          { normcur  defined dynamically! }
  30.         nocur    = $2B0C;
  31.         F1       = #59;              F2       = #60;
  32.         F3       = #61;              F4       = #62;
  33.         F5       = #63;              F6       = #64;
  34.         F7       = #65;              F8       = #66;
  35.         F9       = #67;              F10      = #68;
  36.         CtrlC    = #3;               Esc      = #27;
  37.         Return   = #13;
  38.         Home     = #71;              UpAr     = #72;
  39.         PgUp     = #73;              LfAr     = #75;
  40.         RtAr     = #77;              EndK     = #79;
  41.         DnAr     = #80;              PgDn     = #81;
  42.         Ins      = #82;              Del      = #83;
  43.         CHome    = #119;             CEndK    = #117;
  44.  
  45.   Type tabletype = Array [byte] Of byte;
  46.  
  47.   Var fname : string;
  48.       xlat  : File;
  49.       tabf  : text;
  50.       fbuf  : Array [1..fbufsize] Of byte;
  51.       fsize : word;
  52.       descript, intername : string;
  53.       tstart, tabstart, interstart : word;
  54.       desclen : byte;
  55.       xlatid : byte;
  56.       table : tabletype;
  57.       changed, floaded : boolean;
  58.       ch : char;
  59.       maxlin, maxcol : byte;
  60.       row : byte;
  61.       col, leftcol : integer;
  62.       normcur : word;
  63.       exitsave : Pointer;
  64.  
  65.   Function hexbyte(b : byte) : string;
  66.   { convert a byte to a string                                               }
  67.   Begin                                                            { hexbyte }
  68.     hexbyte := hexnibble[Succ(b ShR 4)] + hexnibble[Succ(b And $0F)];
  69.   End;                                                             { hexbtye }
  70.  
  71.   Procedure beep;
  72.   { error noise                                                              }
  73.   Begin                                                               { beep }
  74.     Sound(440);
  75.     Delay(100);
  76.     NoSound;
  77.   End;                                                                { beep }
  78.  
  79.   Procedure putchar(b : byte);
  80.   { show a character on the screen, without interpreting control chars       }
  81.   Inline($B4/$0F/                {Mov ah, $0F       ; get current video mode }
  82.          $CD/$10/                {Int $10           ; in bh                  }
  83.          $58/                    {Pop ax            ; get char in al         }
  84.          $B4/$0A/                {Mov ah, $0A       ; output char            }
  85.          $B3/$70/                {Mov bl, $70       ; white on black         }
  86.          $B9/$01/$00/            {Mov cx, $01       ; just one copy          }
  87.          $CD/$10);               {Int $10                                    }
  88.  
  89.   Procedure setcursor(curtype : word);
  90.   { set cursor start and end line and blink bits                             }
  91.     Var regs : Registers;
  92.   Begin                                                          { setcursor }
  93.     With regs Do
  94.     Begin
  95.       ah := $0F;
  96.       Intr(videoint,regs);
  97.       cx := curtype;
  98.       ah := $01;
  99.       Intr(videoint,regs);
  100.     End;
  101.   End;                                                           { setcursor }
  102.  
  103.   Procedure getcursor;
  104.   { get cursor start and end line and blink bits, put them into normcur      }
  105.     Var regs : Registers;
  106.   Begin                                                          { setcursor }
  107.     With regs Do
  108.     Begin
  109.       ah := $0F;
  110.       Intr(videoint,regs);
  111.       ah := $03;
  112.       Intr(videoint,regs);
  113.       normcur := cx;
  114.     End;
  115.   End;                                                           { setcursor }
  116.  
  117.   Procedure moreprompt;
  118.   { wait for key press at bottom of 'list' window                            }
  119.     Var ch : char;
  120.   Begin                                                         { moreprompt }
  121.     GoToXY(maxcol-25,8);
  122.     write('Hit space bar...');
  123.     ch := ReadKey;
  124.     While KeyPressed Do ch := ReadKey;
  125.     GoToXY(1,8);
  126.     ClrEoL;
  127.   End;                                                          { moreprompt }
  128.  
  129.   Procedure openlistwindow;
  130.   { open a window in central part of screen                                  }
  131.     Var i : byte;
  132.   Begin                                                     { openlistwindow }
  133.     Window(1,11,maxcol,20);
  134.     ClrScr;
  135.     GoToXY(2,1);
  136.     write(#218);
  137.     For i := 3 To 78 Do write(#196);
  138.     write(#191);
  139.     For i := 2 To 9 Do
  140.     Begin
  141.       GoToXY(2,i);
  142.       write(#179);
  143.       GoToXY(79,i);
  144.       write(#179);
  145.     End;
  146.     GoToXY(2,10);
  147.     write(#192);
  148.     For i := 3 To 78 Do write(#196);
  149.     write(#217);
  150.     Window(4,12,maxcol-4,19);
  151.   End;                                                      { openlistwindow }
  152.  
  153.   Procedure errmsg(s : string);
  154.   { display an error message                                                 }
  155.     Var i : byte;
  156.         ch : char;
  157.   Begin                                                             { errmsg }
  158.     SetCursor(nocur);
  159.     Window(1,11,maxcol,13);
  160.     ClrScr;
  161.     GoToXY(1,1);
  162.     write(#218);
  163.     For i := 1 To Length(s)+2 Do write(#196);
  164.     write(#191);
  165.     GoToXY(1,2);
  166.     write(#179,' ',s,' ',#179);
  167.     GoToXY(1,3);
  168.     write(#192);
  169.     For i := 1 To Length(s)+2 Do write(#196);
  170.     write(#217);
  171.     While KeyPressed Do ch := ReadKey;
  172.     ch := ReadKey;
  173.     While KeyPressed Do ch := ReadKey;
  174.     ClrScr;
  175.     Window(1,1,maxcol,maxlin);
  176.     SetCursor(normcur);
  177.   End;                                                              { errmsg }
  178.  
  179.   Function showfiles(mask : string) : boolean;
  180.   { if mask contains wildcards, show all files that match, then return True  }
  181.     Var wild : boolean;
  182.         i, linct, colct : byte;
  183.         sr : SearchRec;
  184.   Begin                                                          { showfiles }
  185.     wild := False;
  186.     For i := 1 To Length(mask) Do wild := wild Or (mask[i] = '?') Or
  187.                                                   (mask[i] = '*');
  188.     showfiles := wild;
  189.     If Not wild Then Exit;
  190.     openlistwindow;
  191.     FindFirst(mask,Archive+ReadOnly+Hidden,sr);
  192.     linct := 0;
  193.     colct := 0;
  194.     wild := False;
  195.     While DosError = 0 Do
  196.     Begin
  197.       wild := True;
  198.       i := Pos('.',sr.name);
  199.       write(' ':(10-i),sr.name,' ':(4-Length(sr.name)+i));
  200.       Inc(colct);
  201.       If colct >= 5 Then
  202.       Begin
  203.         writeln;
  204.         Inc(linct);
  205.         If linct >= 7 Then
  206.         Begin
  207.           moreprompt;
  208.           linct := 0;
  209.         End;
  210.         colct := 0;
  211.       End;
  212.       FindNext(sr);
  213.     End;
  214.     If Not wild Then
  215.     Begin
  216.       writeln('No files matching "',mask,'"');
  217.       linct := 1;
  218.     End;
  219.     If (linct > 0) Or (colct > 0) Then
  220.     Begin
  221.       writeln;
  222.       moreprompt;
  223.     End;
  224.     Window(1,11,maxcol,20);
  225.     ClrScr;
  226.     Window(1,1,maxcol,maxlin);
  227.   End;                                                           { showfiles }
  228.  
  229.   Procedure initdisplay;
  230.   { initialize display                                                       }
  231.     Var i : byte;
  232.   Begin                                                        { initdisplay }
  233.     Window(1,1,maxcol,maxlin);
  234.     ClrScr;
  235.     GoToXY(3,1);
  236.     write('Internal name: ',intername);
  237.     Case xlatid Of
  238.       10 : write('  (filter)');
  239.       11 : write('  (resident)');
  240.       Else ;
  241.     End;
  242.     While (descript <> '') And (descript[Length(descript)] = ' ') Do
  243.                                          Delete(descript,Len